perm filename DATA.LSP[F87,JMC] blob sn#850854 filedate 1987-12-28 generic text, type T, neo UTF8
;;; -*- Syntax: Common-lisp; Package: PZ; Default-character-style: (:FIX :BOLD :NORMAL) -*-

(special *original-board*)

(defparameter *default-initial-position*
	      '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 :blank))

(defstruct board
  (Name (gentemp "BOARD-"))
  (position (make-array 16 :initial-contents
			 *default-initial-position*))
  (blank 16)					; Current position of blank.
  (blank-origin nil)				; Original position of blank
  (completed-chain 0)				; Length of continuous sequence of tiles in
						;   in correct position, starting with 1.
  (last-complete-row 0)				; Last row whose tiles are all in correct place.
  (moves nil)					; List of moves that generate this position 
						;   from initial position.
  (side 4)					; number of squares on a side.  Size of 
  						;   POSTION should = side squared.
  )

(defstruct FIFO-Queue
  (line (list nil))				; The initial contents of the queue is the node that 
						; is the original position - a node reached in no moves.
  )

(defparameter *base-board*
	      (make-board :name "Base Board"))

(defparameter *hidden-board*
	      (make-board  :name "Hidden Board"))

(defparameter *adjacency-moves*
	      (make-array 16 :initial-contents
			  (loop for ix from 1 to 16
				collect
				  (nconc (when (> (- ix 4) 0)
					   (list (- ix 4)))	;above
					 (unless (= (mod ix 4) 1)
					   (list (- ix 1)))	;left
					 (unless (= (mod ix 4) 0)
					   (list (+ ix 1)))	;right
					 (when (< (+ ix 4) 17)
					   (list (+ ix 4)))))))	;below

(defparameter *Queue* (make-fifo-queue))

(defparameter *acceptances* 0)
(defparameter *rejections* 0)
(defparameter  *nodes-considered* 0)
(defparameter *acceptance-trace* nil)
(defmacro Tform (wl dur &rest args)
  `(if *acceptance-trace* (format t ,@args) (sys:%beep ,wl ,dur)))